home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / c7105.zip / CLARION.TPL < prev    next >
Text File  |  1994-03-02  |  23KB  |  447 lines
  1. #!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
  2. #!│                               Clarion.TPL              │Version: 3007.105│
  3. #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
  4. #!│Structure             Type       Description                              │
  5. #!│────────────────────  ─────────  ─────────────────────────────────────────│
  6. #!│-None-                PROGRAM    Standard Procedure Code                  │
  7. #!│-None-                MODULE     Standard Module Code                     │
  8. #!├──────────────────────────────────────────────────────────────────────────┤
  9. #!│ CLARION.TPL is the first of a chain of template files that contain the   │
  10. #!│ standard Clarion procedure templates.  These templates generate CUA      │
  11. #!│ compliant, text-based applications.  Other files in the template chain   │
  12. #!│ are PullDown.TPX, Menu.TPX, and so forth.                                │
  13. #!│                                                                          │
  14. #!│ Initial screen, report, and action images are contained in corresponding │
  15. #!│ application files with an extension of .APP (e.g. CLARION.APP).          │
  16. #!│                                                                          │
  17. #!│ Template Listing (In CHAIN Order)                                        │
  18. #!│                                                                          │
  19. #!│   Clarion.TPL     Module       Initialize a module                       │
  20. #!│                   Program      Initialize a program                      │
  21. #!│   PullDown.TPX    Pulldown     Execute a procedure from a pulldown menu  │
  22. #!│   Menu.TPX        Menu         Execute a procedure from a pop-up menu    │
  23. #!│   Browse.TPX      Browse       Browse records directly from a file       │
  24. #!│   List.TPX        List         List a file's records from a memory queue │
  25. #!│   Lookup.TPX      Lookup       Setup procedure to lookup a field         │
  26. #!│   Validate.TPX    Validate     Edit procedure to lookup a field          │
  27. #!│   Select.TPX      Select       Load a selected record into memory        │
  28. #!│   Form.TPX        Form         Update a record with a form               │
  29. #!│   MultiPg.TPX     MultiPage    Update a file with a multiple page entry  │
  30. #!│   PageOf.TPX      PageOf       Data entry 'Page' used with the MultiPage │
  31. #!│   Child.TPX       Child        Update a batch of Child records           │
  32. #!│   Report.TPX      Report       Print a report                            │
  33. #!│   Print.TPX       Print        Print a report from memory                │
  34. #!│   Redirect.TPX    Redirect     Select destination for a report           │
  35. #!│   View.TPX        View         View a selected text file in a listbox    │
  36. #!│   Batch.TPX       Batch        Sequential record processing of a file.   │
  37. #!│   File.TPX        File         Select a file from a directory listing    │
  38. #!│   Screen.TPX      Screen       Process any screen                        │
  39. #!│   Source.TPX      Source       Process any source code                   │
  40. #!│   External.TPX    External     Document external procedure call          │
  41. #!│   ToDo.TPX        Todo         Undefined procedure code                  │
  42. #!│   FileCtrl.TPX    #GROUPs      Associated with File Opening/Closing      │
  43. #!│   Relation.TPX    #GROUPs      Associated with R/I Changes/Deletes       │
  44. #!│   ScrnFlds.TPX    #GROUPs      Associated with Screen Edit/Setup Code    │
  45. #!│   BrwsGrps.TPX    #GROUPs      Associated with BROWSE type procedures    │
  46. #!│   ChldGrps.TPX    #GROUPs      Associated with CHILD procedures          │
  47. #!│   FormGrps.TPX    #GROUPs      Associated with FORM type procedures      │
  48. #!│   MiscGrps.TPX    #GROUPs      Used in various places in the CHAIN       │
  49. #!│   RptGrps.TPX     #GROUPs      Associated with REPORT type procedures    │
  50. #!│   Warnings.TPX    #GROUPs      WARNINGS issued (for easy customization)  │
  51. #!│   CPD21.TPX       Form21       Version 2.1-Style Form Procedure          │
  52. #!│                   Menu21       Version 2.1-Style Menu Procedure          │
  53. #!│                   MemForm21    Version 2.1-Style MemForm Procedure       │
  54. #!│                   Table21      Version 2.1-Style Table Procedure         │
  55. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  56. #!│Version   Comments                                                        │
  57. #!│────────  ────────────────────────────────────────────────────────────────│
  58. #!│3007.000  Release of CDD3 version 3007 templates                          │
  59. #!│3007.105  Modified CheckOpen Function                                     │
  60. #!│          Modified CheckOpen Procedure                                    │
  61. #!│          Modified DiskError Function                                     │
  62. #!└──────────────────────────────────────────────────────────────────────────┘
  63. #!
  64. #PROGRAM
  65. #!
  66. #!┌────────────────────────────────────────────────────────┬─────────────────┐
  67. #!│                                #PROGRAM                │Version: 3007.000│
  68. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  69. #!│The Program template generates the PROGRAM statement, MAP structure, FILE │
  70. #!│structures, and global declarations for a Clarion program.  This template │
  71. #!│also blanks the screen and calls the first procedure.  There is only one  │
  72. #!│#PROGRAM segment in a template file chain.                                │
  73. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  74. #!│Version   Comments                                                        │
  75. #!│────────  ────────────────────────────────────────────────────────────────│
  76. #!│3007.000  Release of CDD3 version 3007 templates                          │
  77. #!└──────────────────────────────────────────────────────────────────────────┘
  78. #!
  79. #PROMPT('Enable &Shared Files',CHECK),%SharedFiles
  80. #PROMPT('Enable Mouse Support',CHECK),%MouseSupport
  81. #PROMPT('Enhanced Background?',CHECK),%EnhancedBackground
  82. #PROMPT('Close Unused &Files?',CHECK),%CloseFiles
  83. #PROMPT('If &File Not Found',OPTION),%FileNotFound
  84. #PROMPT('Create',RADIO)
  85. #PROMPT('Halt',RADIO)
  86. #PROMPT('Program &Author',@S30),%Author
  87. #!
  88. #IF(%SharedFiles)
  89.   #SET(%AccessMode,'42h')
  90. #ELSE
  91.   #SET(%AccessMode,'22h')
  92. #ENDIF
  93.                 TITLE('%Program')
  94. OMIT('╝')
  95. ╔════════════════════════════════════════════════════════════════════════════╗
  96. ║  Program - %Program                          #<!                           ║
  97. ║  Author  - %Author                           #<!                           ║
  98. ╚════════════════════════════════════════════════════════════════════════════╝
  99.                  PROGRAM
  100.  
  101.                  INCLUDE('KEYCODES.EQU')
  102.                  INCLUDE('CLARION.EQU')
  103.                  INCLUDE('ERRORS.EQU')
  104.  
  105.                  MAP
  106. #IF(%CloseFiles)
  107.                    CheckOpen(FILE),BYTE
  108. #ELSE
  109.                    CheckOpen(FILE)
  110. #ENDIF
  111.                    DiskError(<STRING>),BYTE
  112.                    ShowWarning
  113.                    %ModuleStructures
  114.                    #EMBED('Inside Global MAP')
  115.                  END
  116.  
  117.                  EJECT('File Layouts')
  118.  
  119. %GlobalData
  120. #EMBED('Before File Declarations')
  121.  
  122. #FOR(%AppFiles)
  123.   #FIX(%File,%AppFiles)
  124.  OMIT('┘')
  125. ┌────────────────────────────────────────────────────────────────────────────┐
  126. │File:   %File                                 #<!                           │
  127. │Prefix: %FilePre                              #<!                           │
  128.   #IF(%FileDescription)
  129. │Desc:   %FileDescription                      #<!                           │
  130.   #ENDIF
  131. │Driver: %FileType                             #<!                           │
  132.   #IF(%FileTypeParameter)
  133. │  Code: %FileTypeParameter                    #<!                           │
  134.   #ENDIF
  135.   #IF(%FileOwner)
  136. │Owner:  %FileOwner                            #<!                           │
  137.   #ENDIF
  138.   #IF(%FileCreate)
  139. │File Create On                                #<!                           │
  140.   #ELSE
  141. │File Create Off                               #<!                           │
  142.   #ENDIF
  143.   #FOR(%Key)
  144. ├────────────────────────────────────────────────────────────────────────────┤
  145.     #IF(%Key=%FilePrimaryKey)
  146. │Key:    %Key (Primary)                        #<!                           │
  147.     #ELSE
  148. │Key:    %Key                                  #<!                           │
  149.     #ENDIF
  150.     #IF(%KeyDescription)
  151. │Desc:   %KeyDescription                       #<!                           │
  152.     #ENDIF
  153.     #IF(%KeyAuto)
  154. │Auto Increment                                #<!                           │
  155.     #ENDIF
  156.     #IF(%KeyDuplicate)
  157. │Key ALLOWS Duplicates                         #<!                           │
  158.     #ELSE
  159. │Key DOES NOT Allow Duplicates                 #<!                           │
  160.     #ENDIF
  161.     #FOR(%KeyField)
  162.       #IF(%KeyFieldSequence = 'ASCENDING')
  163. │Field (Ascending):  %KeyField                 #<!                           │
  164.       #ELSE
  165. │Field (Descending): %KeyField                 #<!                           │
  166.       #ENDIF
  167.     #ENDFOR
  168.   #ENDFOR
  169. └────────────────────────────────────────────────────────────────────────────┘
  170. %FileStructure
  171. #ENDFOR
  172.  
  173. AddRecord        EQUATE(1)                     #<!  Add a new record
  174. ChangeRecord     EQUATE(2)                     #<!  Change the current record
  175. DeleteRecord     EQUATE(3)                     #<!  Delete the current record
  176. SelectRecord     EQUATE(4)                     #<!  Select the current record
  177. #EMBED('Data Section')
  178.  
  179.  
  180.   CODE
  181.   #EMBED('Setup Program')
  182.   LOADSYMBOLS                                  #<!Display graphic mouse
  183.   #IF(%EnhancedBackground)
  184.   SETNOBLINK                                   #<!Enable enhanced colors
  185.   #ENDIF
  186.   #IF(%HelpFile)
  187.   HELP('%HelpFile')                            #<!Open the help file
  188.   #ENDIF
  189.   #IF(%StyleFile )
  190.   GETSTYLES('%StyleFile')                      #<!Open the style file
  191.   #ENDIF
  192.   #IF(%MouseSupport)
  193.   SETMOUSE(1,1)                                #<!Turn on mouse
  194.   #ENDIF
  195.   SETCOLOR(WhiteOnBlack)                       #<!Set white on black
  196.   BLANK                                        #<!Clear the screen
  197.   SETCOLOR                                     #<!Turn off override color
  198.  
  199.   %FirstProcedure                              #<!Call the first procedure
  200.  
  201.   #EMBED('Before return to DOS')
  202.   RETURN                                       #<!Return to DOS
  203.  
  204. OMIT('┘')
  205. #IF(%CloseFiles)                                #!Generate function for close
  206.  
  207. ┌──────────────────────────────┤ Function ├──────────────┬─────────────────┐
  208. │                                 CheckOpen              │Version: 3007.105│
  209. ├──────────────────────────────┤Description├─────────────┴─────────────────┤
  210. │ Function called to insure that a file is open.  In this code, file       │
  211. │ opening is attempted.  If no error is perceived, a Value of 1 is         │
  212. │ returned, informing the calling procedure that the file was indeed       │
  213. │ opened during this call.  If the file is already opened, a Value of      │
  214. │ 0 is returned.  Otherwise, if errors are set by the OPEN procedure,      │
  215. │ the appropriate maintenance actions occur, or the user is informed.      │
  216. ├───────────────────────────────┤Comments├─────────────────────────────────┤
  217. │Version   Comments                                                        │
  218. │────────  ────────────────────────────────────────────────────────────────│
  219. │3007.000  Release of CDD3 version 3007 templates                          │
  220. │3007.105  Added the ProcedureReturn ROUTINE                               │
  221. │          Added several EMBED points                                      │
  222. │          Added LOC::ReturnVal, to allow a common exit point              │
  223. └──────────────────────────────────────────────────────────────────────────┘
  224.  
  225. CheckOpen         FUNCTION(File)
  226. LOC::ReturnVal    BYTE(0)
  227.  
  228.   CODE
  229.   #EMBED('CheckOpen: Setup Procedure')
  230.   OPEN(File,%AccessMode)                       #<!Attempt to open the file
  231.   CASE ERRORCODE()                             #<! and check for errors
  232.   OF NoError                                   #<!Return opened flag
  233.     #EMBED('CheckOpen: No Error')
  234.     LOC::ReturnVal = True
  235.     DO ProcedureReturn                           ! signal successful open
  236.   OF IsOpenErr                                 #<! or if already open.
  237.     #EMBED('CheckOpen: File Open Error')
  238.     DO ProcedureReturn
  239.   #IF(%FileNotFound <> 'Halt')
  240.   OF NoFileErr                                 #<!If file was not found
  241.     #EMBED('CheckOpen: No File Error')
  242.     CREATE(File)                               #<!Create the file
  243.     IF ERRORCODE()
  244.       #INSERT(%CreateFailureMsg)
  245.     END
  246.     OPEN(File,%AccessMode)                     #<! then open it
  247.     IF ~ERRORCODE()                            #<!  And return if it opened
  248.       LOC::ReturnVal = True
  249.       DO ProcedureReturn                         ! signal successful open
  250.     ELSE
  251.       HALT(ERRORCODE())
  252.     END
  253.   #ENDIF
  254.   OF InvalidFileErr                            #<!Invalid Record Declaration
  255.     #EMBED('CheckOpen: Invalid File Error')
  256.     #INSERT(%InvalidFileMsg)
  257.     HALT(InvalidFileErr)
  258.   OF BadKeyErr                                 #<!Key Files must be rebuilt
  259.     #EMBED('CheckOpen: Bad Key Error')
  260.     #INSERT(%BadKeyMsg)
  261.     OPEN(File,12H)                               !Open for exclusive access
  262.     BUILD(File)                                  !Rebuild the key files
  263.     IF ERRORCODE()
  264.       #INSERT(%KeyBuildErrorMsg)
  265.       HALT(BadKeyErr)
  266.     ELSE
  267.       CLOSE(File)                                !Close
  268.       OPEN(File,%AccessMode)                   #<! then re-open it
  269.       LOC::ReturnVal = True
  270.       DO ProcedureReturn                         ! signal successful open
  271.     END
  272.   END                                          #<!End of Case Structure
  273.   IF DiskError(NAME(File) & ' File could not be opened') THEN HALT(0). #<!Cannot resume
  274. ProcedureReturn ROUTINE
  275.   #EMBED('CheckOpen: Directly before return')
  276.   RETURN(LOC::ReturnVal)
  277. #ELSE                                           #!Generate procedure
  278.  
  279. ┌──────────────────────────────┤ Procedure ├─────────────┬─────────────────┐
  280. │                                CheckOpen               │Version: 3007.105│
  281. ├──────────────────────────────┤Description├─────────────┴─────────────────┤
  282. │ Procedure called to insure that a file is open.  In this code, file      │
  283. │ opening is attempted.  If no error is perceived, or the file is already  │
  284. │ open, the procedure returns with no additional action.                   │
  285. │ If errors are set by the OPEN procedure, the appropriate maintenance     │
  286. │ actions occur, or the user is informed.                                  │
  287. ├───────────────────────────────┤Comments├─────────────────────────────────┤
  288. │Version   Comments                                                        │
  289. │────────  ────────────────────────────────────────────────────────────────│
  290. │3007.000  Release of CDD3 version 3007 templates                          │
  291. │3007.105  Added the ProcedureReturn ROUTINE                               │
  292. │          Added several EMBED points                                      │
  293. └──────────────────────────────────────────────────────────────────────────┘
  294.  
  295. CheckOpen         PROCEDURE(File)
  296.  
  297.   CODE
  298.   #EMBED('CheckOpen: Setup Procedure')
  299.   OPEN(File,%AccessMode)                       #<!Attempt to open the file
  300.   CASE ERRORCODE()                             #<! and check for errors
  301.   OF NoError                                   #<!Return if no error
  302.     #EMBED('CheckOpen: No Error')
  303.   OROF IsOpenErr                               #<! or if already open.
  304.     #EMBED('CheckOpen: File Open Error')
  305.     DO ProcedureReturn
  306.   #IF(%FileNotFound <> 'Halt')
  307.   OF NoFileErr                                 #<!If file was not found
  308.     #EMBED('CheckOpen: No File Error')
  309.     CREATE(File)                               #<!Create the file
  310.     IF ERRORCODE()
  311.       #INSERT(%CreateFailureMsg)
  312.     END
  313.     OPEN(File,%AccessMode)                     #<! then open it
  314.     IF ~ERRORCODE()                            #<!  And return if it opened
  315.       DO ProcedureReturn
  316.     ELSE
  317.       HALT(ERRORCODE())
  318.     END
  319.   #ENDIF
  320.   OF InvalidFileErr                            #<!Invalid Record Declaration
  321.     #EMBED('CheckOpen: Invalid File Error')
  322.     #INSERT(%InvalidFileMsg)
  323.     HALT(InvalidFileErr)
  324.   OF BadKeyErr                                 #<!Key Files must be rebuilt
  325.     #EMBED('CheckOpen: Bad Key Error')
  326.     #INSERT(%BadKeyMsg)
  327.     OPEN(File,12H)                             #<!Open for exclusive access
  328.     BUILD(File)                                #<!Rebuild the key files
  329.     IF ERRORCODE()
  330.       #INSERT(%KeyBuildErrorMsg)
  331.       HALT(BadKeyErr)
  332.     ELSE
  333.       CLOSE(File)                              #<!Close
  334.       OPEN(File,%AccessMode)                   #<! then open it
  335.     END
  336.   END                                          #<!End of Case Structure
  337.   IF DiskError(NAME(File) & ' File could not be opened') THEN HALT(0). #<!Cannot resume
  338.   DO ProcedureReturn
  339. ProcedureReturn ROUTINE
  340.   #EMBED('CheckOpen: Directly before return')
  341.   RETURN
  342. #ENDIF
  343. OMIT('┘')
  344.  
  345. ┌──────────────────────────────┤ Function ├──────────────┬─────────────────┐
  346. │                                DiskError               │Version: 3007.105│
  347. ├──────────────────────────────┤Description├─────────────┴─────────────────┤
  348. │ Function called to post errors if a disk related error has occurred.     │
  349. ├───────────────────────────────┤Comments├─────────────────────────────────┤
  350. │Version   Comments                                                        │
  351. │────────  ────────────────────────────────────────────────────────────────│
  352. │3007.000  Release of CDD3 version 3007 templates                          │
  353. │3007.105  Added the ProcedureReturn ROUTINE                               │
  354. │          Added several EMBED points                                      │
  355. │          Added LOC::ReturnVal, to allow a common exit point              │
  356. └──────────────────────────────────────────────────────────────────────────┘
  357.  
  358. DiskError        FUNCTION(Cause)
  359. StopMsg::        STRING(180)
  360. LOC::ReturnVal   BYTE(0)
  361.  
  362.   CODE
  363.   #EMBED('DiskErr: Setup Procedure')
  364.   IF ~ERRORCODE() THEN DO ProcedureReturn.     #<!Return with no error
  365.   IF ~OMITTED(1)                               #<!If a cause was given
  366.     StopMsg:: = 'Cause: ' & Cause & LF:CR      #<!  Display it
  367.   END                                          #<!End IF
  368.   IF ERRORFILE()                               #<!If error involves a file
  369.     StopMsg:: = CLIP(StopMsg::) & 'File : '  | #<!  display the file
  370.               & ERRORFILE() & LF:CR
  371.   END                                          #<!End IF
  372.   StopMsg:: = CLIP(StopMsg::) & 'Error: '    | #<!Display the error code
  373.             & ERRORCODE() & ' - '            | #<!  and the error message
  374.             & ERROR() & LF:CR
  375.  
  376.   STOP(StopMsg::)                              #<!Stop with message
  377.   LOC::ReturnVal = True                        #<!Return with error
  378.   DO ProcedureReturn
  379. ProcedureReturn ROUTINE
  380.   #EMBED('DiskErr: Directly before return')
  381.   RETURN(LOC::ReturnVal)
  382.  
  383. OMIT('╝')
  384. ╔════════════════════════════════════════════════════════════════════════════╗
  385. ║  Display a warning message using 3 Global message variables.               ║
  386. ╚════════════════════════════════════════════════════════════════════════════╝
  387. ShowWarning      PROCEDURE
  388.  
  389. SaveStyle        STRING(256)
  390.  
  391. Screen           SCREEN(9,53),PRE(SCR),CENTER,SHADOW,CUA,COLOR(112)
  392.                    ROW(1,1)    STRING('█▀{51}█'),COLOR(116)
  393.                    ROW(9,1)    STRING('█▄{51}█'),COLOR(116)
  394.                                REPEAT(7)
  395.                    ROW(2,1)      STRING('█'),COLOR(116)
  396.                    ROW(2,53)     STRING('█'),COLOR(116)
  397.                                .
  398.                    ROW(3,5)    ENTRY(@S45),USE(GLO:Message1),INS,SKIP,COLOR(112,112,112)
  399.                    ROW(4,5)    ENTRY(@S45),USE(GLO:Message2),INS,SKIP,COLOR(112,112,112)
  400.                    ROW(5,5)    ENTRY(@s45),USE(GLO:Message3),INS,SKIP,COLOR(112,112,112)
  401.                    ROW(7,24)   BUTTON('  &Ok  |'),SHADOW,USE(?Ok),COLOR(23,71,24,31,79)
  402.                  .
  403.  
  404.   CODE
  405.   #EMBED('ShowWarning: Setup Procedure')
  406.   SaveStyle = STYLES()                         #<!Save current style
  407.   GETSTYLES('')                                #<!Turn off Styles
  408.   GLO:Message1 = CENTER(GLO:Message1,SIZE(GLO:Message1))
  409.   GLO:Message2 = CENTER(GLO:Message2,SIZE(GLO:Message2))
  410.   GLO:Message3 = CENTER(GLO:Message3,SIZE(GLO:Message3))
  411.   #EMBED('ShowWarning: Before Screen Opening')
  412.   OPEN(Screen)
  413.   DISPLAY
  414.   ACCEPT                                       #<!Enable keyboard and mouse
  415.   #EMBED('ShowWarning: After Accept')
  416.   CLEAR(GLO:MessageGroup)                      #<!Blank out message fields
  417.   SETSTYLES(SaveStyle)                         #<!Restore user styles
  418.   DO ProcedureReturn
  419. ProcedureReturn ROUTINE
  420.   #EMBED('ShowWarning: Directly before return')
  421.   RETURN
  422.  
  423. #!
  424. #MODULE
  425. #!
  426. #!┌────────────────────────────────────────────────────────┬─────────────────┐
  427. #!│                                 #MODULE                │Version: 3007.000│
  428. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  429. #!│The Module template generates the MEMBER statement, and module level data │
  430. #!│declarations for a source module of a Clarion program.  There is only one │
  431. #!│#MODULE segment in a template file chain.                                 │
  432. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  433. #!│Version   Comments                                                        │
  434. #!│────────  ────────────────────────────────────────────────────────────────│
  435. #!│3007.000  Release of CDD3 version 3007 templates                          │
  436. #!└──────────────────────────────────────────────────────────────────────────┘
  437. #!
  438.                 MEMBER('%Program')
  439. OMIT('╝')
  440. ╔════════════════════════════════════════════════════════════════════════════╗
  441. ║   %Module - %ModuleDescription               #<!                           ║
  442. ╚════════════════════════════════════════════════════════════════════════════╝
  443. %ModuleData
  444. #EMBED('Data Section')
  445. #!
  446. #CHAIN('PullDown.tpx')
  447.